home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Amiga-E / E_v3.2a / Src / Various / freq.e < prev    next >
Text File  |  1992-09-02  |  9KB  |  380 lines
  1. /* compute frequency of words in file. read in any ascii file, and spits
  2.    the result (as table) on stdout, or process on existing freqlist
  3.  
  4.    FILE/A,SERVER/S,FREQFILE/S,ENGLISHOPTI/S,HEAVY/S
  5.  
  6.    FILE:        words to process
  7.    SERVER:    go into server mode
  8.    FREQFILE:    expect input to be in frequency list format or just any ascii text
  9.    ENGLISHOPTI: perform merges on english words (note: needs multiple passes)
  10.    HEAVY:       do heavy english opti (does more damage to semantics :-)
  11.    FREQFACTOR:  minimum factor of frequency for output words in server mode [default: 100]
  12.  
  13. */
  14.  
  15. OPT REG=5,OSVERSION=37
  16.  
  17. MODULE 'tools/file', 'tools/exceptions', 'class/hash', 'tools/ctype', 'tools/arexx',
  18.        'tools/constructors', 'exec/nodes', 'exec/lists'
  19.  
  20. OBJECT hlink OF hashlink
  21.   count, sig
  22. ENDOBJECT
  23.  
  24. CONST NUMTOP=1000
  25.  
  26. DEF ght:PTR TO hashtable,pht:PTR TO hashtable, -> silly
  27.     gsize,psize,                               -> number of words
  28.     isheavy=FALSE,iseng=FALSE,
  29.     minsig=100,top:PTR TO lh,largest
  30.  
  31. PROC main() HANDLE
  32.   DEF m,l,ht=NIL:PTR TO hashtable,myargs:PTR TO LONG,rdargs=NIL
  33.   myargs:=[0,0,0,0,0,0]
  34.   IF (rdargs:=ReadArgs('FILE/A,SERVER/S,FREQFILE/S,ENGLISHOPTI/S,HEAVY/S,FREQFACTOR/N',myargs,NIL))=NIL THEN Raise("ARGS")
  35.   m,l:=readfile(myargs[0])
  36.   ght:=NEW ht.hashtable(HASH_HEAVIER)
  37.   gsize:=IF iseng:=myargs[2] THEN process_fl(m,l,ht) ELSE process(m,l,ht)
  38.   IF gsize<1 THEN gsize:=1
  39.   isheavy:=myargs[4]
  40.   IF myargs[5] THEN minsig:=Long(myargs[5])
  41.   IF myargs[3] THEN ht.iterate({engfilter})
  42.   IF myargs[1] THEN server() ELSE ht.iterate({print})
  43. EXCEPT DO
  44.   IF rdargs THEN FreeArgs(rdargs)
  45.   report_exception()
  46. ENDPROC
  47.  
  48. PROC process(mem,len,ht:PTR TO hashtable,listd=NIL)
  49.   DEF p,c,a,b,h,end,hl:PTR TO hlink,numw=0,list
  50.   end:=mem+len
  51.   p:=mem
  52.   LOOP
  53.     SELECT 128 OF c:=p[]++
  54.       CASE "\n"
  55.         IF p>end THEN RETURN numw
  56.       CASE "A" TO "Z", "a" TO "z"
  57.         IF c<="Z" THEN p[-1]:=c+32
  58.         a:=p-1
  59.         WHILE isalpha(c:=p[])
  60.           IF c<="Z" THEN p[]:=c+32
  61.           p++
  62.         ENDWHILE
  63.         hl,h:=ht.find(a,b:=p-a)
  64.         IF hl=NIL THEN ht.add(NEW hl,h,a,b)
  65.         hl.count:=hl.count+1
  66.         numw++
  67.         p[]++:=0
  68.         IF listd
  69.           ^listd:=list:=NEW [NIL,hl]:LONG
  70.           listd:=list
  71.         ENDIF
  72.     ENDSELECT
  73.   ENDLOOP
  74. ENDPROC
  75.  
  76. PROC process_fl(m,l,ht:PTR TO hashtable)
  77.   DEF b,h,end,hl:PTR TO hlink,v,s,numw=0
  78.   end:=m+l
  79.   s:=m
  80.   WHILE s<end
  81.     v,b:=Val(s)
  82.     s:=s+b+1
  83.     b:=s
  84.     WHILE b[]<>"\n" DO b++
  85.     b:=b-s
  86.     hl,h:=ht.find(s,b)
  87.     IF hl=NIL THEN ht.add(NEW hl,h,s,b)
  88.     hl.count:=hl.count+v
  89.     numw:=numw+v
  90.     s:=s+b
  91.     s[]++:=0
  92.   ENDWHILE
  93. ENDPROC numw
  94.  
  95. /*
  96.     ["."=checked, "*"=sem_danger, "#"=not_impl]
  97.  
  98.     safe extension optimisations:
  99.  
  100. ..    Xed    X | Xe        conversed
  101. .    Xied    Xy        crucified
  102. .    XYYed    XY        crammed, abhorred
  103. ..    Xing    X | Xe        conspiring
  104. .    Xan    Xa        american, an
  105.  .    Xian    Xy | Xia    hungarian, australian
  106. .    Xier    Xy        copier
  107. .    Xs    X        conveys, as?, this?
  108. .    Xous    X        courageous
  109. .    Xies    Xy        contemporaries
  110. .    Xness    X        remoteness
  111.     Xy    Xe        argueably
  112. .#    Xly    X | Xe        convincingly
  113. .    Xility    Xle        intangibility
  114. .    Xacy     Xate        indelicacy
  115.  
  116.         less safe extension optimisations:
  117.  
  118.     activities -> activity -> active -> act
  119.  
  120. *    Xic    X        alcoholic
  121. *    Xive    X | Xe        constructive
  122. **    Xable    X | Xe        argueable
  123. ###    Xial    X | Xe | Xia    residential
  124. #    Xtial    Xce        consequential
  125. *    Xism    X        alcoholism
  126. *    Xion    X | Xe        damnation, deallocation
  127. *    Xor    X | Xe        coordinator
  128. #    Xious    Xy        ceremonious
  129. ##    Xant    X | Xe        colorant
  130. ##    Xment    X | Xe        containment
  131. #    Xlet    X        booklet
  132. .*#    Xily    X | Xe | Xy    particularily, family?
  133. *    Xity    X        actuality
  134.  
  135.     not used for now:
  136.  
  137.     Xves    Xfe        leaves
  138.     Xer    X | Xe        manager?
  139.     Xward    X        upward, awkward?, reward?
  140.     Xar    X        singular?
  141.     Xss
  142.     Xibly
  143.     Xend
  144.  
  145.     safe prefix optimisations:
  146.  
  147.     unX    X        unacceptable            -> same as "not X"
  148.     imX    X        imperfect, image?
  149.     inX    X        incoherent
  150.  
  151.         less safe prefix optimisations:
  152.  
  153.     deX    X        decompression
  154.     reX    X        rebuilt
  155.     misX    X        misguided
  156.  
  157.     not used for now:
  158.  
  159.     overX    X        overflow?
  160.     preX    X        prefixed?
  161.     disX    X        dissatisfied, discover?
  162.     upX    X        uproar?
  163.     superX    X        superimpose?
  164.     nonX    X        nondeterministically?
  165.  
  166. */
  167.  
  168. PROC engfilter(tl:PTR TO hlink,d)
  169.   DEF l,s,hl=NIL:PTR TO hlink,v,w,x,y,z,t[100]:STRING,min=3 ->4?
  170.   l:=tl.len
  171.   s:=tl.data
  172.   z:=s[l-1]
  173.   IF l>1
  174.     y:=s[l-2]
  175.     IF l>2
  176.       x:=s[l-3]
  177.       IF l>3
  178.         w:=s[l-4]
  179.         IF l>4 THEN v:=s[l-4]
  180.       ENDIF
  181.     ENDIF
  182.   ENDIF
  183.   SELECT 128 OF z
  184.   CASE "c"
  185.     IF y="i" THEN hl:=fh(s,l-2)                    -> ic
  186.   CASE "d"
  187.     IF y="e"
  188.       IF x="i"                            -> ied
  189.         hl:=suf(t,s,l-3,'y')
  190.       ELSEIF x=w                        -> XXed
  191.         hl:=f(s,l-3)
  192.       ELSE                            -> ed
  193.         IF (hl:=f(s,l-2))=NIL THEN hl:=f(s,l-1)
  194.       ENDIF
  195.     ENDIF
  196.   CASE "e"
  197.     IF (x="i") AND (y="v")                    -> ive
  198.       IF (hl:=fh(s,l-3))=NIL THEN hl:=sufh(t,s,l-3,'e')
  199.     ELSEIF (w="a") AND (x="b") AND (y="l")
  200.       IF (hl:=fh(s,l-4))=NIL THEN hl:=sufh(t,s,l-4,'e')
  201.     ENDIF
  202.   CASE "g"
  203.     IF (x="i") AND (y="n")                    -> ing
  204.       IF (hl:=f(s,l-3))=NIL THEN hl:=suf(t,s,l-3,'e')
  205.     ENDIF
  206.   CASE "m"
  207.     IF (x="i") AND (y="s") THEN hl:=fh(s,l-3)            -> ism
  208.   CASE "n"
  209.     IF y="a"
  210.       IF x="i"                            -> ian
  211.         IF (hl:=suf(t,s,l-3,'y'))=NIL THEN hl:=f(s,l-1)
  212.       ELSE                            -> an
  213.         hl:=f(s,l-1)
  214.       ENDIF
  215.     ELSEIF (y="o") AND (x="i")                    -> ion
  216.       IF (hl:=fh(s,l-3))=NIL THEN hl:=sufh(t,s,l-3,'e')
  217.     ENDIF
  218.   CASE "r"
  219.     IF y="o"                            -> or
  220.       IF (hl:=fh(s,l-2))=NIL THEN hl:=sufh(t,s,l-2,'e')
  221.     ENDIF
  222.   CASE "s"
  223.     IF (x="o") AND (y="u")                    -> ous
  224.       hl:=f(s,l-3)
  225.     ELSEIF (x="i") AND (y="e")                    -> ies
  226.       hl:=suf(t,s,l-3,'y')
  227.     ELSEIF (w="n") AND (x="e") AND (y="s")            -> ness
  228.       hl:=f(s,l-4)
  229.     ELSE                            -> s
  230.       hl:=f(s,l-1)
  231.     ENDIF
  232.   CASE "y"
  233.     IF y="l"
  234.       IF x="i"                            -> ily
  235.         IF (hl:=fh(s,l-3))=NIL THEN hl:=sufh(t,s,l-3,'e')
  236.       ELSE                            -> ly
  237.         hl:=f(s,l-2)
  238.       ENDIF
  239.     ELSEIF (y="t") AND (x="i")
  240.       IF (v="i") AND (w="l")                    -> ility
  241.         hl:=suf(t,s,l-5,'le')
  242.       ELSE                            -> ity
  243.         hl:=fh(s,l-3)
  244.       ENDIF
  245.     ELSEIF y="c"                        -> acy
  246.       hl:=suf(t,s,l-2,'te')
  247.     ELSE                            -> y
  248.       hl:=suf(t,s,l-1,'e')
  249.     ENDIF
  250.   ENDSELECT
  251.   IF hl=NIL
  252.     min:=4
  253.     IF IF ((x:=s[])="u") THEN s[1]="n" ELSE IF x="i" THEN    -> un/in/im
  254.           ((y:=s[1])="n") OR (y="m") ELSE FALSE
  255.       hl:=f(s+2,l-2)
  256.     ENDIF
  257.   ENDIF
  258.   IF hl
  259.     IF (hl.len>=min) AND ((hl.count>1) OR (hl.count=0))
  260.       hl.count:=hl.count+tl.count
  261.       tl.count:=0
  262.     ENDIF
  263.   ENDIF
  264. ENDPROC
  265.  
  266. PROC suf(dest,src,len,suf)
  267.   StrCopy(dest,src,len)
  268.   StrAdd(dest,suf)
  269. ENDPROC ght.find(dest,EstrLen(dest))
  270.  
  271. PROC f(s,l) IS ght.find(s,l)
  272. PROC fh(s,l) IS IF isheavy THEN ght.find(s,l) ELSE NIL
  273. PROC sufh(d,s,l,su) IS IF isheavy THEN suf(d,s,l,su) ELSE NIL
  274.  
  275. PROC print(l:PTR TO hlink,d)
  276.   PrintF('\d[8]\t\s\n',l.count,l.data)
  277. ENDPROC
  278.  
  279. PROC server()
  280.   WriteF('Starting Arexx Server, port: "FREQPORT", commands: "QUIT", "FREQ"\n')
  281.   rx_HandleAll({process_msg},'FREQPORT')
  282. ENDPROC
  283.  
  284. PROC process_msg(s)
  285.   DEF cl,a=NIL,q=FALSE
  286.   IF (cl:=InStr(s,' '))>0 THEN a:=s+cl+1
  287.   IF StrCmp(s,'QUIT',cl)
  288.     WriteF('Terminating server.\n')
  289.     q:=TRUE
  290.   ELSEIF StrCmp(s,'FREQ',cl)
  291.     WriteF('Processing file "\s".\n',a)
  292.     do(a)
  293.   ELSE
  294.     WriteF('Unknown Command: "\s"\n',s)
  295.   ENDIF
  296. ENDPROC q,0,NIL
  297.  
  298. PROC do(filename) HANDLE
  299.   DEF m=NIL,l,ht=NIL:PTR TO hashtable,list=NIL
  300.   top:=pht:=NIL
  301.   m,l:=readfile(filename)
  302.   pht:=NEW ht.hashtable(HASH_HEAVY)
  303.   psize:=process(m,l,ht,{list})
  304.   IF psize<1 THEN psize:=1
  305.   IF iseng THEN ht.iterate({engfilter})
  306.   WriteF('word ratio = \d:\d\n',gsize,psize)
  307.   largest:=0
  308.   ht.iterate({significant})
  309.   top:=newlist()
  310.   largest:=largest/127+1
  311.   ht.iterate({sort})
  312.   writenewfile(list,filename)
  313.   writetop(filename)
  314. EXCEPT DO
  315.   END top
  316.   IF pht THEN pht.end_links(SIZEOF hlink)
  317.   END pht
  318.   IF m THEN freefile(m)
  319.   report_exception()
  320. ENDPROC
  321.  
  322. PROC significant(phl:PTR TO hlink,d)
  323.   DEF numg=1,nump,hl:PTR TO hlink,sig
  324.   nump:=phl.count
  325.   IF hl:=ght.find(phl.data,phl.len) THEN numg:=hl.count
  326.   IF numg<1 THEN numg:=1
  327.   IF nump<1 THEN nump:=1
  328.   phl.sig:=sig:=Div(Div(gsize,numg),Div(psize,nump))
  329.   IF sig>largest THEN largest:=sig
  330. ENDPROC
  331.  
  332. PROC sort(phl:PTR TO hlink,d)
  333.   IF phl.sig>minsig THEN Enqueue(top,newnode(NIL,phl,0,phl.sig/largest))
  334. ENDPROC
  335.  
  336. PROC writenewfile(list:PTR TO LONG,fn)
  337.   DEF hl:PTR TO hlink,o:PTR TO LONG,fh,nfn[200]:STRING,numc=0
  338.   StrCopy(nfn,fn)
  339.   StrAdd(nfn,'.sig')
  340.   IF fh:=Open(nfn,NEWFILE)
  341.     WHILE o:=list
  342.       hl:=list[1]
  343.       list:=list[]
  344.       END o[2]
  345.       IF hl.sig>minsig
  346.         IF numc+hl.len+1>78 THEN (numc:=0) BUT FputC(fh,"\n")
  347.         Fputs(fh,hl.data)
  348.         FputC(fh," ")
  349.         numc:=numc+hl.len+1
  350.       ENDIF
  351.     ENDWHILE
  352.     FputC(fh,"\n")
  353.     Close(fh)
  354.   ELSE
  355.     WriteF('Problem opening "\s"\n',nfn)
  356.   ENDIF
  357. ENDPROC
  358.  
  359. PROC writetop(fn)
  360.   DEF n:PTR TO ln,o,fh,nfn[200]:STRING,hl:PTR TO hlink,num,totsig=0,f
  361.   StrCopy(nfn,fn)
  362.   StrAdd(nfn,'.top')
  363.   IF fh:=Open(nfn,NEWFILE)
  364.     n:=top.head; num:=0
  365.     WHILE o:=n.succ
  366.       hl:=n.name; num++; EXIT num=NUMTOP; totsig:=totsig+hl.sig; n:=o
  367.     ENDWHILE
  368.     f:=totsig/num/100+1
  369.     WriteF('tot=\d,num=\d,f=\d\n',totsig,num,f)
  370.     n:=top.head; num:=0
  371.     WHILE o:=n.succ
  372.       hl:=n.name; num++; EXIT num=NUMTOP; VfPrintf(fh,'\s:\d\n',[hl.data,hl.sig/f]:LONG); END n; n:=o
  373.     ENDWHILE
  374.     FputC(fh,"\n")
  375.     Close(fh)
  376.   ELSE
  377.     WriteF('Problem opening "\s"\n',nfn)
  378.   ENDIF
  379. ENDPROC
  380.